home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue68 / Construc / DMCalendar.pas next >
Encoding:
Pascal/Delphi Source File  |  2001-02-28  |  3.2 KB  |  126 lines
  1. unit DMCalendar;
  2. {$DEFINE INTERFACE}
  3. interface
  4. uses
  5.   Windows, SysUtils, Classes, Controls, Forms,
  6.   Calendar, DB, DBCtrls;
  7.  
  8. {$IFDEF INTERFACE}
  9. type
  10.   IDataAware = interface
  11.    ['{FFC47B41-0D51-11D5-8131-00104BF89DAD}']
  12.     function GetDataSource: TDataSource;
  13.     procedure SetDataSource(const Value: TDataSource);
  14.     function GetDataField: string;
  15.     procedure SetDataField(const Value: string);
  16.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  17.     property DataField: String read GetDataField write SetDataField;
  18.   end;
  19. {$ENDIF}
  20.  
  21. type
  22.   TDMCalendar = class(TCalendar {$IFDEF INTERFACE}, IDataAware{$ENDIF})
  23.   private
  24.     FFieldDataLink: TFieldDataLink;
  25.     function GetDataField: String;
  26.     function GetDataSource: TDataSource;
  27.     procedure SetDataField(const Value: String);
  28.     procedure SetDataSource(const Value: TDataSource);
  29.     { Private declarations }
  30.   protected
  31.     { Protected declarations }
  32.     procedure DataChange(Sender: TObject); // date changed in table
  33.     procedure Change; override; // date changed by user in calendar
  34.     procedure UpdateData(Sender: TObject); // change data in table
  35.     procedure CmExit(var Message: TCmExit); message CM_Exit;
  36.   public
  37.     { Public declarations }
  38.     constructor Create(AOwner: TComponent); override;
  39.     destructor Destroy; override;
  40.   published
  41.     { Published declarations }
  42.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  43.     property DataField: String read GetDataField write SetDataField;
  44.   end;
  45.  
  46. procedure Register;
  47.  
  48. implementation
  49.  
  50. procedure Register;
  51. begin
  52.   RegisterComponents('DrBob42', [TDMCalendar]);
  53. end;
  54.  
  55. { TDMCalendar }
  56.  
  57. constructor TDMCalendar.Create(AOwner: TComponent);
  58. begin
  59.   inherited;
  60.   FFieldDataLink := TFieldDataLink.Create;
  61.   FFieldDataLink.OnDataChange := DataChange;
  62.   FFieldDataLink.OnUpdateData := UpdateData
  63. end;
  64.  
  65. destructor TDMCalendar.Destroy;
  66. begin
  67.   FFieldDataLink.Free;
  68.   FFieldDataLink := nil;
  69.   inherited
  70. end;
  71.  
  72. function TDMCalendar.GetDataField: String;
  73. begin
  74.   Result := FFieldDataLink.FieldName
  75. end;
  76.  
  77. function TDMCalendar.GetDataSource: TDataSource;
  78. begin
  79.   Result := FFieldDataLink.DataSource
  80. end;
  81.  
  82. procedure TDMCalendar.SetDataField(const Value: String);
  83. begin
  84.   FFieldDataLink.FieldName := Value
  85. end;
  86.  
  87. procedure TDMCalendar.SetDataSource(const Value: TDataSource);
  88. begin
  89.   FFieldDataLink.DataSource := Value
  90. end;
  91.  
  92. procedure TDMCalendar.DataChange(Sender: TObject);
  93. begin
  94.   if Assigned(FFieldDataLink.Field) then
  95.     if (FFieldDataLink.Field IS TDateField) or
  96.        (FFieldDataLink.Field IS TDateTimeField) then
  97.       CalendarDate := FFieldDataLink.Field.AsDateTime
  98. end;
  99.  
  100. procedure TDMCalendar.Change;
  101. begin
  102.   FFieldDataLink.Modified;
  103.   inherited
  104. end;
  105.  
  106. procedure TDMCalendar.UpdateData(Sender: TObject);
  107. begin
  108.   if Assigned(FFieldDataLink.Field) then
  109.     if (FFieldDataLink.Field IS TDateField) or
  110.        (FFieldDataLink.Field IS TDateTimeField) then
  111.       FFieldDataLink.Field.AsDateTime := CalendarDate
  112. end;
  113.  
  114. procedure TDMCalendar.CmExit(var Message: TCmExit);
  115. begin
  116.   try
  117.     FFieldDataLink.UpdateRecord
  118.   except
  119.     SetFocus;
  120.     raise // re-raise exception
  121.   end;
  122.   inherited
  123. end;
  124.  
  125. end.
  126.